(defpackage :lem-ncurses/key
  (:use :cl
        :lem)
  (:export :get-code
           :char-to-key
           :get-key-from-name))
(in-package :lem-ncurses/key)

(defvar *keycode-table* (make-hash-table))
(defvar *keyname-table* (make-hash-table :test 'equal))

(defun defkeycode (name code &optional key)
  (setf (gethash name *keyname-table*) code)
  (when key (setf (gethash code *keycode-table*) key)))

(defun get-code (name)
  (let ((code (gethash name *keyname-table*)))
    (assert code)
    code))

(defun char-to-key (char)
  (or (gethash (char-code char) *keycode-table*)
      (make-key :sym (string char))))

(defun get-key-from-name (name)
  (char-to-key (code-char (get-code name))))

(defkeycode "C-@" 0 (make-key :ctrl t :sym "@"))
(defkeycode "C-a" 1 (make-key :ctrl t :sym "a"))
(defkeycode "C-b" 2 (make-key :ctrl t :sym "b"))
(defkeycode "C-c" 3 (make-key :ctrl t :sym "c"))
(defkeycode "C-d" 4 (make-key :ctrl t :sym "d"))
(defkeycode "C-e" 5 (make-key :ctrl t :sym "e"))
(defkeycode "C-f" 6 (make-key :ctrl t :sym "f"))
(defkeycode "C-g" 7 (make-key :ctrl t :sym "g"))
(defkeycode "C-h" 8 (make-key :ctrl t :sym "h"))
(defkeycode "C-i" 9 (make-key :sym "Tab"))
(defkeycode "C-j" 10 (make-key :ctrl t :sym "j"))
(defkeycode "C-k" 11 (make-key :ctrl t :sym "k"))
(defkeycode "C-l" 12 (make-key :ctrl t :sym "l"))
(defkeycode "C-m" 13 (make-key :sym "Return"))
(defkeycode "C-n" 14 (make-key :ctrl t :sym "n"))
(defkeycode "C-o" 15 (make-key :ctrl t :sym "o"))
(defkeycode "C-p" 16 (make-key :ctrl t :sym "p"))
(defkeycode "C-q" 17 (make-key :ctrl t :sym "q"))
(defkeycode "C-r" 18 (make-key :ctrl t :sym "r"))
(defkeycode "C-s" 19 (make-key :ctrl t :sym "s"))
(defkeycode "C-t" 20 (make-key :ctrl t :sym "t"))
(defkeycode "C-u" 21 (make-key :ctrl t :sym "u"))
(defkeycode "C-v" 22 (make-key :ctrl t :sym "v"))
(defkeycode "C-w" 23 (make-key :ctrl t :sym "w"))
(defkeycode "C-x" 24 (make-key :ctrl t :sym "x"))
(defkeycode "C-y" 25 (make-key :ctrl t :sym "y"))
(defkeycode "C-z" 26 (make-key :ctrl t :sym "z"))
(defkeycode "escape" 27 (make-key :sym "Escape"))
(defkeycode "C-\\" 28 (make-key :ctrl t :sym "\\"))
(defkeycode "C-]" 29 (make-key :ctrl t :sym "]"))
(defkeycode "C-^" 30 (make-key :ctrl t :sym "^"))
(defkeycode "C-_" 31 (make-key :ctrl t :sym "_"))
(defkeycode "Spc" #x20 (make-key :sym "Space"))
(defkeycode "[backspace]" #x7F (make-key :sym "Backspace"))

(loop :for code :from #x21 :below #x7F
      :do (let ((string (string (code-char code))))
            (defkeycode string code (make-key :sym string))))

(defkeycode "[down]" #o402 (make-key :sym "Down"))
(defkeycode "[up]" #o403 (make-key :sym "Up"))
(defkeycode "[left]" #o404 (make-key :sym "Left"))
(defkeycode "[right]" #o405 (make-key :sym "Right"))
(defkeycode "C-down" 525 (make-key :ctrl t :sym "Down"))
(defkeycode "C-down_en" 526 (make-key :ctrl t :sym "Down"))
(defkeycode "M-up" 564 (make-key :meta t :sym "Up"))
(defkeycode "M-up_en" 565 (make-key :meta t :sym "Up"))
(defkeycode "M-down_en" 524 (make-key :meta t :sym "Down"))
(defkeycode "M-left_en" 544 (make-key :meta t :sym "Left"))
(defkeycode "M-right_en" 559 (make-key :meta t :sym "Right"))
(defkeycode "C-up" 566 (make-key :ctrl t :sym "Up"))
(defkeycode "C-up_en" 567 (make-key :ctrl t :sym "Up"))
(defkeycode "C-left" 545 (make-key :ctrl t :sym "Left"))
(defkeycode "C-left_en" 546 (make-key :ctrl t :sym "Left"))
(defkeycode "C-right" 560 (make-key :ctrl t :sym "Right"))
(defkeycode "C-right_en" 561 (make-key :ctrl t :sym "Right"))
(defkeycode "[home]" #o406 (make-key :sym "Home"))
(defkeycode "[backspace]" #o407 (make-key :sym "Backspace"))
(defkeycode "[f0]" #o410 (make-key :sym "F0"))
(defkeycode "[f1]" #o411 (make-key :sym "F1"))
(defkeycode "[f2]" #o412 (make-key :sym "F2"))
(defkeycode "[f3]" #o413 (make-key :sym "F3"))
(defkeycode "[f4]" #o414 (make-key :sym "F4"))
(defkeycode "[f5]" #o415 (make-key :sym "F5"))
(defkeycode "[f6]" #o416 (make-key :sym "F6"))
(defkeycode "[f7]" #o417 (make-key :sym "F7"))
(defkeycode "[f8]" #o420 (make-key :sym "F8"))
(defkeycode "[f9]" #o421 (make-key :sym "F9"))
(defkeycode "[f10]" #o422 (make-key :sym "F10"))
(defkeycode "[f11]" #o423 (make-key :sym "F11"))
(defkeycode "[f12]" #o424 (make-key :sym "F12"))
(defkeycode "[sf1]" #o425 (make-key :shift t :sym "F1"))
(defkeycode "[sf2]" #o426 (make-key :shift t :sym "F2"))
(defkeycode "[sf3]" #o427 (make-key :shift t :sym "F3"))
(defkeycode "[sf4]" #o430 (make-key :shift t :sym "F4"))
(defkeycode "[sf5]" #o431 (make-key :shift t :sym "F5"))
(defkeycode "[sf6]" #o432 (make-key :shift t :sym "F6"))
(defkeycode "[sf7]" #o433 (make-key :shift t :sym "F7"))
(defkeycode "[sf8]" #o434 (make-key :shift t :sym "F8"))
(defkeycode "[sf9]" #o435 (make-key :shift t :sym "F9"))
(defkeycode "[sf10]" #o436 (make-key :shift t :sym "F10"))
(defkeycode "[sf11]" #o437 (make-key :shift t :sym "F11"))
(defkeycode "[sf12]" #o440 (make-key :shift t :sym "F12"))
(defkeycode "[dl]" #o510)
(defkeycode "[il]" #o511)
(defkeycode "[dc]" #o512 (make-key :sym "Delete"))
(defkeycode "C-dc" 519 (make-key :ctrl t :sym "Delete"))
(defkeycode "[ic]" #o513)
(defkeycode "[eic]" #o514)
(defkeycode "[clear]" #o515)
(defkeycode "[eos]" #o516)
(defkeycode "[eol]" #o517)
(defkeycode "[sf]" #o520 (make-key :shift t :sym "Down"))
(defkeycode "[sr]" #o521 (make-key :shift t :sym "Up"))
(defkeycode "[npage]" #o522 (make-key :sym "PageDown"))
(defkeycode "[ppage]" #o523 (make-key :sym "PageUp"))
(defkeycode "[stab]" #o524)
(defkeycode "[ctab]" #o525)
(defkeycode "[catab]" #o526)
(defkeycode "[enter]" #o527)
(defkeycode "[print]" #o532)
(defkeycode "[ll]" #o533)
(defkeycode "[a1]" #o534)
(defkeycode "[a3]" #o535)
(defkeycode "[b2]" #o536)
(defkeycode "[c1]" #o537)
(defkeycode "[c3]" #o540)
(defkeycode "[btab]" #o541  (make-key :shift t :sym "Tab"))
(defkeycode "[beg]" #o542)
(defkeycode "[cancel]" #o543)
(defkeycode "[close]" #o544)
(defkeycode "[command]" #o545)
(defkeycode "[copy]" #o546)
(defkeycode "[create]" #o547)
(defkeycode "[end]" #o550 (make-key :sym "End"))
(defkeycode "[exit]" #o551)
(defkeycode "[find]" #o552)
(defkeycode "[help]" #o553)
(defkeycode "[mark]" #o554)
(defkeycode "[message]" #o555)
(defkeycode "[move]" #o556)
(defkeycode "[next]" #o557)
(defkeycode "[open]" #o560)
(defkeycode "[options]" #o561)
(defkeycode "[previous]" #o562)
(defkeycode "[redo]" #o563)
(defkeycode "[reference]" #o564)
(defkeycode "[refresh]" #o565)
(defkeycode "[replace]" #o566)
(defkeycode "[restart]" #o567)
(defkeycode "[resume]" #o570)
(defkeycode "[save]" #o571)
(defkeycode "[sbeg]" #o572)
(defkeycode "[scancel]" #o573)
(defkeycode "[scommand]" #o574)
(defkeycode "[scopy]" #o575)
(defkeycode "[screate]" #o576)
(defkeycode "[sdc]" #o577 (make-key :shift t :sym "Delete"))
(defkeycode "[sdl]" #o600)
(defkeycode "[select]" #o601)
(defkeycode "[send]" #o602 (make-key :shift t :sym "End"))
(defkeycode "[seol]" #o603)
(defkeycode "[sexit]" #o604)
(defkeycode "[sfind]" #o605)
(defkeycode "[shelp]" #o606)
(defkeycode "[shome]" #o607 (make-key :shift t :sym "Home"))
(defkeycode "[sic]" #o610)
(defkeycode "[sleft]" #o611 (make-key :shift t :sym "Left"))
(defkeycode "[smessage]" #o612)
(defkeycode "[smove]" #o613)
(defkeycode "[snext]" #o614 (make-key :shift t :sym "PageDown"))
(defkeycode "[soptions]" #o615)
(defkeycode "[sprevious]" #o616 (make-key :shift t :sym "PageUp"))
(defkeycode "[sprint]" #o617)
(defkeycode "[sredo]" #o620)
(defkeycode "[sreplace]" #o621)
(defkeycode "[sright]" #o622 (make-key :shift t :sym "Right"))
(defkeycode "[srsume]" #o623)
(defkeycode "[ssave]" #o624)
(defkeycode "[ssuspend]" #o625)
(defkeycode "[sundo]" #o626)
(defkeycode "[suspend]" #o627)
(defkeycode "[undo]" #o630)
(defkeycode "[mouse]" #o631)
(defkeycode "[resize]" #o632)
(defkeycode "[event]" #o633)
